perm filename DATUM.SAI[PUB,TES] blob sn#200327 filedate 1976-01-30 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00021 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	BEGOF("DATUM")
C00004 00003	IFK PASSONE THENK
C00007 00004	IFK PASSONE THENK
C00009 00005	IFK PASSONE THENK
C00011 00006	IFK PASSONE THENK
C00012 00007	IFK PASSONE THENK
C00013 00008	IFK PASSONE OR PASSTWO THENK
C00014 00009	IFK PASSONE THENK
C00015 00010	IFK PASSONE THENK
C00016 00011	IFK PASSONE THENK
C00017 00012	IFK PASSONE THENK
C00018 00013	IFK PASSONE THENK
C00019 00014	IFK PASSONE THENK
C00020 00015	IFK PASSONE THENK
C00021 00016	IFK PASSONE THENK
C00022 00017	IFK PASSONE THENK
C00023 00018	IFK PASSONE OR PASSTWO THENK
C00024 00019	IFK PASSONE THENK
C00025 00020	IFK PASSONE THENK
C00026 00021	IFK PASSONE THENK
C00027 ENDMK
C⊗;
BEGOF("DATUM")

IFC PASSONE THENC

COMMENT

DAN SWINEHART'S EXPANDABLE ARRAY PACKAGE

Declares
IDA ← [S]CREATE(LOWBND, HIGHBND) to create a (string or) integer array
MAKEBE(IDA,ALIAS) to give its descriptor to array ALIAS
IDA ← [S]WHATIS(ALIAS) to take it back
GOAWAY(IDA) to destroctulate it
IDA ← [S]BIGGER(IDA,XTRA) to add XTRA words to its length.

PLUS some of our own functions to PUSH records onto stacks and to PUT
records onto heaps (herein called TBLs).

;

ENDC

EXTERNAL INTEGER GOGTAB ;

PROCEDURES
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE DATUM! ;$"#
BEGIN "DATUM!"
WISTK←WHATIS(ISTK) ; WITBL←WHATIS(ITBL) ; WINEST←WHATIS(INEST) ;
WSSTK←SWHATIS(SSTK) ; WSTBL←SWHATIS(STBL) ; WSNEST←SWHATIS(SNEST) ;
WSYM←SWHATIS(SYM) ; WNUMBER←WHATIS(NUMBER) ; WOLDPAGE←WHATIS(OLDPAGE) ;
WNEWPAGE←WHATIS(NEWPAGE) ; WTHISFRAME←WHATIS(THISFRAME);
WMOLES←WHATIS(MOLES) ; WOWLS←WHATIS(OWLS) ; WNMOLES←WHATIS(NMOLES) ;
WNOWLS←WHATIS(NOWLS) ; WTHISAREA←WHATIS(THISAREA) ; WWAITBOX←WHATIS(WAITBOX) ;
WAVAILREC←WHATIS(AVAILREC) ; WAA←WHATIS(AA) ; WNAA←WHATIS(NAA) ;
WSHORT←WHATIS(SHORT) ; WNSHORT←WHATIS(NSHORT) ;
WMLEAD←WHATIS(MLEAD) ; WNMLEAD←WHATIS(NMLEAD) ; TES 11/2/74 ;
ITBLIDA ← RH(CREATE(0, ITSIZE)) ; ISTKIDA ← RH(CREATE(0, ISIZE)) ; INESTIDA ← RH(CREATE(0, SIZE)) ;
STBLIDA ← RH(SCREATE(0, STSIZE)) ; SSTKIDA ← RH(SCREATE(0, SSIZE)) ; SNESTIDA ← RH(SCREATE(0, SIZE)) ;
SYMIDA ← RH(SCREATE(-1, SYMNO)) ; NUMBIDA ← RH(CREATE(-1, SYMNO)) ;
MAKEBE(ITBLIDA, ITBL) ; MAKEBE(ISTKIDA, ISTK) ; MAKEBE(INESTIDA, INEST) ;
SMAKEBE(STBLIDA, STBL) ; SMAKEBE(SSTKIDA, SSTK) ; SMAKEBE(SNESTIDA, SNEST) ;
SMAKEBE(SYMIDA, SYM) ; MAKEBE(NUMBIDA, NUMBER) ;
LAST ← IHED ← SHED ← IHIGH ← SHIGH ← 0 ; comment Tops of Stacks;
OLDPGIDA←NEWPGIDA←FRAMEIDA←
	MOLESIDA←MLEADIDA←SHORTIDA←OWLSIDA←
	AREAIDA←WBOXIDA←STATUS←AREAIXM←0 ;
END "DATUM!" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE FINIDATUM ;$"#
BEGIN "FINIDATUM"
FOR J ← ITBLIDA, ISTKIDA, INESTIDA, NUMBIDA DO GOAWAY(J) ;
FOR J ← STBLIDA, SSTKIDA, SNESTIDA, SYMIDA DO GOAWAY(-1 LSH 18 + J) ;
FOR J ← 1 THRU 35 DO IF FNTFIL[J] NEQ 0 THEN GOAWAY(FNTFIL[J]) ;

MAKEBE(WCW,CW);
MAKEBE(WISTK, ISTK) ; MAKEBE(WITBL, ITBL) ; MAKEBE(WINEST, INEST) ;
SMAKEBE(WSSTK, SSTK) ; SMAKEBE(WSTBL, STBL) ; SMAKEBE(WSNEST, SNEST) ;
SMAKEBE(WSYM, SYM) ; MAKEBE(WNUMBER, NUMBER) ; MAKEBE(WOLDPAGE, OLDPAGE) ;
MAKEBE(WNEWPAGE, NEWPAGE) ; MAKEBE(WTHISFRAME,THISFRAME);
MAKEBE(WMOLES, MOLES) ; MAKEBE(WOWLS, OWLS) ; MAKEBE(WNMOLES, NMOLES) ;
MAKEBE(WSHORT, SHORT) ; MAKEBE(WNSHORT, NSHORT) ;
MAKEBE(WMLEAD, MLEAD) ; MAKEBE(WNMLEAD, NMLEAD) ; TES 11/2/74 ;
MAKEBE(WNOWLS, NOWLS) ; MAKEBE(WTHISAREA, THISAREA) ; MAKEBE(WWAITBOX, WAITBOX) ;
MAKEBE(WAVAILREC, AVAILREC) ; MAKEBE(WAA, AA) ; MAKEBE(WNAA, NAA) ;
END "FINIDATUM" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE BIGGER(INTEGER PTR,HM) ;$"#
BEGIN "BIGGER"
    INTEGER PT,L,U,OLDXIDA,NEWXIDA;
    INTEGER ARRAY OLDX,NEWX[0:ONE];
    OLDXIDA←WHATIS(OLDX);
    NEWXIDA←WHATIS(NEWX);
    MAKEBE(PTR,OLDX);
    L←ARRINFO(OLDX,1);
    U←ARRINFO(OLDX,2);
    PT←LRMAK(L,U+HM,1);
    MAKEBE(PT,NEWX);
    ARRTRAN(NEWX,OLDX);
    MAKEBE(OLDXIDA,OLDX);
    MAKEBE(NEWXIDA,NEWX);
    GOAWAY(PTR);
    RETURN(PT);
END "BIGGER";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE BIGGR2(INTEGER PTR,HM) ;$"#
BEGIN "BIGGR2"
    INTEGER PT,L,U,OLDXIDA,NEWXIDA;
    INTEGER ARRAY OLDX,NEWX[1:ONE,0:ONE];
    OLDXIDA←WHATIS(OLDX);
    NEWXIDA←WHATIS(NEWX);
    MAKEBE(PTR,OLDX);
    L←ARRINFO(OLDX,1);
    U←ARRINFO(OLDX,2);
    PT ← CREATE2(L,U, ARRINFO(OLDX,3), HM+ARRINFO(OLDX,4)) ;
    MAKEBE(PT,NEWX);
    ARRTRAN(NEWX,OLDX);
    MAKEBE(OLDXIDA,OLDX);
    MAKEBE(NEWXIDA,NEWX);
    GOAWAY(PTR);
    RETURN(PT);
END "BIGGR2";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE CREATE2(INTEGER LB1, UB1, LB2, UB2) ;$"#
	BEGIN "CREATE2"
	SIMPLE EXTERNAL INTEGER PROCEDURE LRMAK(INTEGER LB1,UB1,LB2,UB2,D) ;
	START!CODE MOVE '15, GOGTAB END ; COMMENT LRCOP BUG ;
	RETURN(LRMAK(LB1, UB1, LB2, UB2, 2)) ;
	END "CREATE2" ;
ENDC
IFK PASSONE OR PASSTWO THENK
PUBLIC SIMPLE PROCEDURE GOAWAY(INTEGER I) ;$"#
BEGIN COMMENT Be SURE Left Half is -1 for String Arrays! ;
START!CODE MOVE '15, GOGTAB END ;
IF 0 LAND LH(I) THEN	COMMENT This code looks totally wrong.  REG 1/30/76;
START!CODE "SARID"
HRRZ 1, I ; MOVE 1, 0(1) ; COMMENT [PREV,,NEXT] ;
HLRZ 2, 1 ; HRRM 1, 0(2) ; COMMENT PREV ← [...,,NEXT] ;
HRRZ 2, 1 ; SKIPE 2 ; HLLM 1, 0(2) ; COMMENT NEXT←[PREV,,...] ;
END "SARID" ;
ARYEL(I) ;
END "GOAWAY" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE GROW(REFERENCE INTEGER ARRAY ARR; REFERENCE INTEGER IDA,WDS;
	INTEGER EXTRA; STRING WHY) ;$"#
BEGIN "GROW"
IDA ← RH(BIGGER(WHATIS(ARR),EXTRA));  WDS ← WDS + EXTRA ;
IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries.  Utterly unmanageable.  Goodbye!") ;
END "GROW" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUSHI(INTEGER WDS, TYP) ;$"#
	BEGIN "PUSHI"
	INTEGER QI ;
	IF (IHED ← IHED + WDS+1) > ISIZE THEN
		BEGIN
		GROW(ISTK, ISTKIDA, ISIZE, 1000, NULL) ;
		MAKEBE(ISTKIDA,ISTK)
		END ;
	ISTK[IHED] ← TYP ROT -9 LOR (IHED-WDS-1) ;
	ZEROWORDS(WDS, ISTK[IHED-WDS]) ; RETURN(IHED) ;
	END "PUSHI" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUSHS(INTEGER WDS; STRING FIRST) ;$"#
	BEGIN"PUSHS"
	INTEGER QI ;
	IF (SHED ← SHED + WDS) > SSIZE THEN
		BEGIN
		SGROW(SSTK, SSTKIDA, SSIZE, 200, NULL) ;
		SMAKEBE(SSTKIDA,SSTK) ; ZEROSTRINGS(200, SSTK[SSIZE-199]) ;
		END ;
	SSTK[SHED] ← FIRST ;
	FOR QI←WDS-1 DOWN 1 DO SSTK[SHED-QI]←NULL ; RETURN(SHED) ;
	END "PUSHS" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUTI(INTEGER WDS, FIRST) ;$"#
	BEGIN"PUTI"
	INTEGER QI ;
	IF (IHIGH ← IHIGH + WDS) > ITSIZE THEN
		BEGIN
		GROW(ITBL, ITBLIDA, ITSIZE, 300, NULL) ;
		MAKEBE(ITBLIDA,ITBL) ;
		END ;
	ITBL[IHIGH] ← FIRST ;
	ZEROWORDS(WDS-1, ITBL[IHIGH-WDS+1]) ; RETURN(IHIGH) ;
	END "PUTI" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUTS(STRING VAL) ;$"#
	BEGIN"PUTS"
	INTEGER QI ;
	IF (SHIGH ← SHIGH + 1) > STSIZE THEN
		BEGIN
		SGROW(STBL, STBLIDA, STSIZE, 200, NULL) ;
		SMAKEBE(STBLIDA,STBL) ; ZEROSTRINGS(200, STBL[STSIZE-199]) ;
		END ;
	 STBL[SHIGH] ← VAL ;
	RETURN(SHIGH) ;
	END "PUTS" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE SBIGGER(INTEGER PTR,HM) ;$"#
BEGIN "SBIGGER"
    EXTERNAL INTEGER PROCEDURE ARRINFO(STRING ARRAY S; INTEGER I);
    EXTERNAL PROCEDURE ARRTRAN(STRING ARRAY S1,S2);
    INTEGER PT,L,U,SOLDIDA,SNEWIDA;
    STRING ARRAY SOLD,SNEW[0:ONE];
    SOLDIDA←SWHATIS(SOLD);
    SNEWIDA←SWHATIS(SNEW);
    SMAKEBE(PTR,SOLD);
    L←ARRINFO(SOLD,1);
    U←ARRINFO(SOLD,2);
    PT←LRMAK(L,U+HM,-1 LSH 18 + 1);
    SMAKEBE(PT,SNEW);
    ARRTRAN(SNEW,SOLD);
    MAKEBE(SOLDIDA,SOLD);
    MAKEBE(SNEWIDA,SNEW);
    GOAWAY(PTR);
    RETURN(PT);
END "SBIGGER";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE SCREATE(INTEGER LB1, UB1) ;$"#
BEGIN "SCREATE"
INTEGER IDA ;
START!CODE MOVE '15, GOGTAB END ;
IDA ← LRMAK(LB1, UB1, -1 LSH 18 + 1) ;
RETURN(IDA) ;
END "SCREATE" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE SGROW(REFERENCE STRING ARRAY ARR; REFERENCE INTEGER IDA,WDS ;
	INTEGER EXTRA; STRING WHY) ;$"#
BEGIN "SGROW"
IDA ← RH(SBIGGER(SWHATIS(ARR),EXTRA));  WDS ← WDS + EXTRA ;
IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries.  Utterly unmanageable.  Goodbye!") ;
END "SGROW" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE SWHATIS(STRING ARRAY A) ;$"#
START!CODE "SWHATIS"
 MOVE 1,A;
END "SWHATIS";
ENDC
IFK PASSONE OR PASSTWO THENK
PUBLIC INTEGER SIMPLE PROCEDURE WHATIS(INTEGER ARRAY A) ;$"#
START!CODE "WHATIS"
 MOVE 1,A;
END "WHATIS";
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE ZEROSTRINGS(INTEGER STRS; REFERENCE STRING LOCN) ;$"#
BEGIN
START!CODE "ZOS"
LABEL DUN ;
SKIPG 1, STRS ;
JRST DUN ; COMMENT NO STRS TO ZERO -- QUIT ;
ADD 1, 1 ; COMMENT TWO WORDS PER STRING ;
HRRZ 2, -1('17) ; COMMENT LOCN ;
SUBI 2, 1 ; COMMENT POINT TO COUNT WORD FIRST ;
SETZM 0(2) ;
ADDI 1, -1(2) ;
HRL 2, 2 ;
ADDI 2, 1 ;
BLT 2, (1) ;
DUN:
END ;
END "ZEROSTRINGS" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE ZEROWORDS(INTEGER WDS; REFERENCE INTEGER LOCN) ;$"#
BEGIN "ZEROWORDS"
START!CODE "ZOT"
LABEL DUN ;
SKIPG 1, WDS ;
JRST DUN ; COMMENT NO WDS TO ZERO -- QUIT ;
HRRZ 2, -1('17) ; COMMENT LOCN ;
SETZM 0(2) ;
CAIN 1, 1 ;
JRST DUN ; COMMENT ONLY 1 -- DON'T BLT ! ;
ADDI 1, -1(2) ;
HRL 2, 2 ;
ADDI 2, 1 ;
BLT 2, (1) ;
DUN:
END ;
END "ZEROWORDS" ;
ENDC
IFK PASSONE THENK

FINISHED

ENDOF("DATUM")

ENDC